##------------------------------------------------------------------------------
##
##	yasco-1.0 - Yet Another (Java)Script Obfuscator
##	Copyright (C) 2008-2011 Oliver Schieche <post@oliver-schieche.de>
##
##	Makes use of Yapp
##	Parse::Yapp - Copyright (c) 1998-2001, Francois Desarmenien, all right reserved.
##
##	$Id: Lexer.pm 12 2012-10-01 13:57:30Z goresplatter1844@gmail.com $
##------------------------------------------------------------------------------
package Yasco::Lexer;

use strict;

use Carp qw/confess croak/;
use Yasco::Node;
##------------------------------------------------------------------------------
BEGIN {
	$Yasco::Lexer::whitespace = '';
	$Yasco::Lexer::asi = {
		49 => sub {77 == $_[1]},
		53 => 1,
	}
}
##------------------------------------------------------------------------------
sub lex
	{
		my ($p) = shift;
		my @t;
		my $state = ${$p->{STACK}}[$#{$p->{STACK}}];

		if (@{$p->{TOKEN_STACK}})
			{
				@t = @{pop @{$p->{TOKEN_STACK}}};
				$p->{CURSOR} -= length($t[0]);
			}
		elsif (0 > $p->{CURSOR})
			{
				return ('',undef);
			}
		else
			{
				my ($l) = substr($p->{DATA}, $p->{CURSOR});
				unless (length($l))
					{
						$p->verbose(1, "%s <EOF>\n", ('X'x75));
						$p->{CURSOR} = -1;
						return ('EOF','EOF');
					}
				@t = _get_token($l,$p);
			}

{no warnings;
		unshift @{$p->{LAST_TOKEN}}, [@t];
		splice @{$p->{LAST_TOKEN}}, 6;
}

		my $text = shift @t;
		$p->{CURSOR} += length($text);
		return lex($p) if -1 == $#t;

		$p->verbose(1, "%s state #%d: got: '%s', last: '%s'\n", ('X'x 75), $$state[0], $text, (${${$p->{LAST_TOKEN}}[0]}[0]));

		@t;
	}
##------------------------------------------------------------------------------
sub _get_token
	{
		my $t = shift;
		my $pre = $Yasco::Main::instance->get_token($t);
		return $pre if $pre;

		MATCH: for ($t) {
			m/^([ \t]+)/ and do
				{
					$Yasco::Lexer::whitespace .= $1;
					return ($1);
				};
			m/^(([\r\n]+)\s*)/ and do
				{
					$Yasco::Lexer::whitespace .= $1;
					my ($p,$nl) = (shift,$2);
					NLC: {
						last NLC if $nl =~ m{^\r+$};
						$nl =~ s/\r//g;
					}
					$p->{LINE} += length($nl);
					return $1;
				};

			# avoid lss here

			m=^/\*= and do
				{
					my ($parser) = shift;
					my ($cb) = index($t,'*/');
					-1 == $cb and croak(sprintf("unterminated comment block starting in line %d", $parser->{LINE}));
					$cb = substr($t, 0, $cb+2);
					$Yasco::Lexer::whitespace .= $cb;
					my ($delta,$p,$test);

					CLINES: for ($delta = 0,$test = $cb;;$delta++)
						{
							last CLINES if (-1 == ($p = index($test,"\n")));
							$test = substr($test,$p+1);
						}
					$parser->{LINE} += $delta;
					return ($cb);
				};
			m=^(//[^\r\n]*)= and do
				{
					$Yasco::Lexer::whitespace .= $1;
					return($1);
				};
			m=^/[^/\r\n]*/= and do
				{
					NOT_A_REGEX: {
						my ($p,$exit) = (1,0);
						my ($lt) = 0;

						++$lt while $lt <= $#{$_[0]->{LAST_TOKEN}} &&
									$_[0]->{LAST_TOKEN}->[$lt]->[0] =~ m{^\s+$};

						GET_REGEX: {
							for ($_[0]->{LAST_TOKEN}->[$lt]) {

								')' eq $_->[1]				and last NOT_A_REGEX;
								']' eq $_->[1]				and last NOT_A_REGEX;
								'T_NUMBER' eq $_->[1]		and last NOT_A_REGEX;
								'T_IDENTIFIER' eq $_->[1]	and last NOT_A_REGEX;

							}

							for ($_[0]->{STACK}->[-1]) {

								'Yasco::Node' ne ref $_->[1]	and last GET_REGEX;
								'CALL' eq $_->[1]->op		and last NOT_A_REGEX;

							}
						}

						while (!$exit) {
							my $c = substr($t,$p,1);

							$p+=2,next if '\\' eq $c;
							++$p;
							last if '/' eq $c;
						}
						++$p while substr($t,$p,1) =~ m/[igu]/;
						$t = substr($t,0,$p);
						return($t, 'T_REGEX', Yasco::Node->new(qq{T_REGEX}, $t));
					}
				};
			m/^((?:<<|>>>?|[-+*\/%&^|])=)/ and
				return($1, 'T_ASSIGNMENT', $1);
			m/^(<<|>>>?)/ and
				return($1, 'T_BITWISE_SHIFT', $1);
			m/^([!=]==?)/ and
				return($1, 'T_EQUALITY', $1);
			m/^([><]=?)/ and
				return($1, 'T_RELATIONAL', $1);
			m/^=/ and
				return('=','T_ASSIGNMENT','=');
			m/^(&&|\|\|)/ and
				return($1, 'T_LOGIC', $1);
			m/^([&|^])/ and
				return($1, 'T_BITWISE', $1);
			m/^([!~])/ and
				return($1, 'T_UNARY', uc($1));
			m/^(delete|new|typeof|void)(\b)/ and
				return($1, 'T_UNARY', uc($1));
			m/^(\+\+|\-\-)/ and
				return($1, 'T_INCDEC', $1);
			m/^\{/ and do
				{
					Yasco::Node::__start_block($_[0]->{LINE}+1);
					return('{','{');
				};
			m/^([\'\"])/ and do
				{
					my ($q,$p) = ($1,1);
					while (1) {
						my $c = substr($t,$p,1);

						$p+=2,next if '\\' eq $c;
						last if $q eq $c;
						++$p;
					}

					$q = $q.substr($t,1,$p-1).$q;
					return($q, 'T_STRING', Yasco::Node->new(qq{STRING},$q));
				};

			m/^(abstract|boolean|byte|char|class|const|debugger|double|enum|export|extends|final|float|goto|implements|import|int|interface|long|native|package|private|protected|public|short|static|super|synchronized|throws|transient|volatile)\b/ and
				return($1, 'T_FUTURE_RESERVED_WORD_' . uc($1), uc($1));

			m/^([gs]et)\b/ and do
				{
					HASH_GETSET: {
						last HASH_GETSET unless $Yasco::Main::instance->filter_option('Yasco::Parser')->{hash_get_set};
						return($1, 'T_'.uc($1), Yasco::Node->new(uc($1)))
							if '.' ne ${${$_[0]->{LAST_TOKEN}}[0]}[0];
					}
				};

			m=^([()\[\]:;,}!+\-*%/?])= and
				return($1,$1);
			m/^(break|case|catch|continue|default|do|else|elseif|finally|for|function|in|instanceof|return|switch|this|throw|try|var|while|with)\b/ and
				return($1, 'T_'.uc($1), Yasco::Node->new(uc($1)));
			m/^(if)\b/ and
				return($1, 'T_'.uc($1));
			m/^(false|null|true|undefined)\b/ and
				return($1, 'T_CONSTANT', Yasco::Node->new(qq{CONSTANT}, $1));
			m/^(0x[a-f0-9]+)/i and
				return($1, 'T_NUMBER', Yasco::Node->new(qq{NUMBER}, $1));
			m/^((?:\-?\d+(?:[Ee]\d+)?(?:\.\d+)?)|(?:0x[a-f0-9]+))/ and
				return($1, 'T_NUMBER', Yasco::Node->new(qq{NUMBER}, $1));
			m/^(\.\d+)/ and
				return($1, 'T_NUMBER', Yasco::Node->new(qq{NUMBER}, $1));
			m=^([.])= and
				return($1,$1);
			m/^([\$a-z0-9_]+)/i and
				return($1, 'T_IDENTIFIER', Yasco::Node->new(qq{ID}, $1));
		}

		my ($p) = shift;
		my (@t) = split /\n/, substr($p->{DATA},$p->{CURSOR});
		confess sprintf("no match \@%d 0x%x, line %d: <%02x>%s", $p->{CURSOR}, $p->{CURSOR}, $p->{LINE}+1, ord(substr($t[0],0,1)), $t[0]);
	}
##------------------------------------------------------------------------------
1